home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / standalone / rpmdrake < prev    next >
Encoding:
Text File  |  2000-01-12  |  15.1 KB  |  504 lines
  1. #!/usr/bin/perl
  2.  
  3.  
  4. use lib qw(/usr/lib/libDrakX);
  5. use common qw(:common :file :functional :system);
  6. use my_gtk qw(:all);
  7. use POSIX ":sys_wait_h";
  8. use interactive_gtk;
  9. use c;
  10.  
  11. local $_ = join '', @ARGV;
  12.  
  13. /-h/ and die "usage: rpmdrake [--uninstall] [--bigmem] [--lowmem]\n";
  14.  
  15. $> && `id -Gn` !~ /urpmi/ and exec "kdesu", "-c", "$0 @ARGV";
  16.  
  17. $::isStandalone = 1;
  18.  
  19. my $DIR = "/var/lib/urpmi";
  20. my $bigMem = availableRam() > 60000;
  21.  
  22. c::rpmReadConfigFiles();
  23.  
  24. my $in = interactive_gtk->new;
  25. my $w = $in->wait_message('', _("reading configuration"));
  26.  
  27. my %installed; @installed{split ' ', `rpm -qa --queryformat "%{NAME} "`} = ();
  28.  
  29. my @medias = map { /list\.(.*)$/ } glob_("$DIR/list.*");
  30. my @media_types = qw(CDROM local FTP HTTP);
  31. my (%entries2node, $current_name, %groups, %entries, $provides, $root, $tree_title, $isUninstall, %provides);
  32.  
  33. $isUninstall = 1 if /-uninstall/;
  34. $bigMem = 1 if /-bigmem/;
  35. $bigMem = 0 if /-lowmem/;
  36.  
  37. my $window = new Gtk::Window;
  38. my $tree_window = new Gtk::ScrolledWindow(undef, undef);
  39. my $tree;
  40.  
  41. $window->signal_connect(delete_event => sub { Gtk->main_quit });
  42. $window->set_title("rpmdrake");
  43. gtkadd($window, gtkpack_(new Gtk::VBox(0,4),
  44.   0, gtkappend(new Gtk::MenuBar,
  45.     create_menu(_("File"),
  46.           gtksignal_connect(new Gtk::MenuItem(_("Quit")), 'activate' => sub { Gtk->main_quit }),
  47.         ),
  48.     create_menu(_("Search"),
  49.         gtksignal_connect(new Gtk::MenuItem(_("Package")), 'activate' => \&SearchPackage),
  50.         gtksignal_connect(new Gtk::MenuItem(_("File")), 'activate' => \&SearchPackageFile),
  51.         gtksignal_connect(new Gtk::MenuItem(_("Text")), 'activate' => \&SearchPackageDescr),
  52.     ),
  53.     create_menu(_("Tree"), 
  54.           create_menu(_("Sort by"),
  55.               gtksignal_connect(new Gtk::MenuItem(_("Category")), 'activate' => sub { CreateTree($isUninstall, 'noflat') }),
  56.               gtksignal_connect(new Gtk::MenuItem(_("Package")), 'activate' => sub { CreateTree($isUninstall, 'flat') }),
  57.           ),
  58.           create_menu(_("See"),
  59.           gtksignal_connect(new Gtk::MenuItem(_("Installed packages")), 'activate' => sub { CreateTree(1) }),
  60.           gtksignal_connect(new Gtk::MenuItem(_("Available packages")), 'activate' => sub { CreateTree(0) }),
  61.           ),
  62.           my $w_leaves = gtksignal_connect(new Gtk::MenuItem(_("Show only leaves")), 'activate' => sub { CreateTree($isUninstall, 'urpmi_rpm-find-leaves --show-unknown') }),
  63. #           my $w_leaves = create_menu(_("Show only leaves"),
  64. #           gtksignal_connect(new Gtk::MenuItem(_("Fast but dirty")), 'activate' => sub { CreateTree($isUninstall, 'urpmi_rpm-find-leaves') }),
  65. #           gtksignal_connect(new Gtk::MenuItem(_("Precise but slow")), 'activate' => sub { CreateTree($isUninstall, 'rpm-find-leaves') }),
  66. #           ),
  67.           gtksignal_connect(new Gtk::MenuItem(_("Expand all")), 'activate' => sub { $tree->expand_recursive(undef) }),
  68.           gtksignal_connect(new Gtk::MenuItem(_("Collapse all")), 'activate' => sub { $tree->collapse_recursive(undef) }),
  69.     ),
  70.     create_menu(_("Configuration"),
  71.           create_menu(_("Add location of packages"),
  72.                map { my $m = $_; gtksignal_connect(new Gtk::MenuItem($_), 
  73.                                'activate' => sub { AddMedia($m) }) 
  74.              } @media_types),
  75.           create_menu(_("Update location"),
  76.                map { my $e = $_; gtksignal_connect(new Gtk::MenuItem($_), 
  77.                                'activate' => sub { UpdateMedia($e) }) 
  78.              } @medias),
  79.               create_menu(_("Remove"),
  80.            map { my $e = $_; gtksignal_connect(new Gtk::MenuItem($_), 
  81.                                'activate' => sub { RemoveMedia($e) })
  82.              } @medias),
  83.     ),
  84.   ),
  85.   0, my $toolbar = new Gtk::Toolbar('horizontal', 'icons'),
  86.   1, gtkpack(new Gtk::HBox(0,0),
  87.          gtkadd($tree_title = new Gtk::Frame(''),
  88.             gtkset_usize($tree_window, 180, 300)),
  89.          gtkpack_(gtkset_usize(new Gtk::VBox(0,0), 350, 0),
  90.               1, createScrolledWindow(my $info_widget = new Gtk::Text),
  91.               0, my $button = new Gtk::Button,
  92.                  )))
  93. );
  94. $tree_window->add($tree = Gtk::CTree->new(1, 0));
  95. $tree->set_selection_mode('browse');
  96. $tree->realize;
  97.  
  98. my %toolbar = my @toolbar = 
  99. (
  100.  fileopen=>[ _("Configuration: Add Location"), sub { AddMedia($in->ask_from_list('', "Which media?", \@media_types) || return) } ],
  101.  ftout =>  [ _("Expand Tree") , sub { $tree->expand_recursive(undef) } ],
  102.  ftin  =>  [ _("Collapse Tree") , sub { $tree->collapse_recursive(undef) } ],
  103.  find  =>  [ _("Find Package"), \&SearchPackage ],
  104.  findf =>  [ _("Find Package containing file"), \&SearchPackageFile ],
  105.  reload=>  [ _("Toggle between Installed and Available"), sub { CreateTree(!$isUninstall) } ],
  106. );
  107. $toolbar->show;
  108. $toolbar->set_button_relief("none");
  109. foreach (grep_index { $::i % 2 == 0 } @toolbar) {
  110.     gtksignal_connect($toolbar->append_item(undef, $toolbar{$_}[0], undef, gtkxpm($tree, "/usr/lib/libDrakX/icons/$_.xpm")),
  111.               clicked => $toolbar{$_}[1]);
  112. }
  113. $toolbar->set_style("icons");
  114.  
  115. my @icon = xpm_d($tree, my @icon_xpm);
  116. my @group_open  = xpm_d($tree, my @group_open_xpm);
  117. my @group_close = xpm_d($tree, my @group_close_xpm);
  118.  
  119. CreateTree();
  120.  
  121. $window->show;
  122. $button->hide;
  123. $button->signal_connect('clicked' => sub { $isUninstall ? Uninstall() : Install() });
  124. $w = undef; 
  125. Gtk->main;
  126. $in->exit(0);
  127.  
  128. sub select_row {
  129.     my ($name) = @_;    
  130.     if (my $e = $entries{$name}) {
  131.     my (undef, $version, $release, $size, $summary, $description, @files) = @$e;
  132.  
  133.     $button->show;
  134.     $current_name = $name;
  135.     gtktext_insert($info_widget, "$summary\n\n" .
  136.                _("Version: %s\n", "$version-$release") .
  137.                _("Size: %d KB\n", $size / 1024) . "\n" .
  138.                formatLines($description) .
  139.                (@files ? "\n\n" . _("Files:\n") . join("\n", @files) : "")
  140.                );
  141.     } else {
  142.     $button->hide;
  143.     gtktext_insert($info_widget, '');
  144.     }
  145. }
  146.  
  147. sub CreateTree {
  148.     $isUninstall = $_[0] if defined $_[0];
  149.     my $option = $_[1];
  150.     %entries = (); %groups = (); %entries2node = ();
  151.     $isUninstall ? read_installed($option =~ "leaves" && $option) : read_hdlists();
  152.  
  153.     $w_leaves->set_sensitive($isUninstall);
  154.  
  155.     $tree_window->remove($tree);
  156.     $tree->destroy;
  157.     gtkadd($tree_window, $tree = Gtk::CTree->new(1, 0));
  158.     $tree->set_selection_mode('browse');
  159.  
  160.     $button->remove($button->children) if $button->children;
  161.     gtkadd($button, $isUninstall ? _("Uninstall") : _("Install"));
  162.  
  163.     $tree_title->set_label($isUninstall ? _("Installed packages") : _("Choose package to install"));
  164.  
  165.     $root = {};
  166.  
  167.     my $flat if 0;
  168.     $flat = 1 if $option eq 'flat';
  169.     $flat = 0 if $option eq 'noflat';
  170.  
  171.     if ($flat) {
  172.     $entries2node{$_} = node($root, $_, 1, 0) foreach sort keys %entries;
  173.     } else {
  174.     foreach (sort keys %groups) {
  175.         my $r = $root;
  176.         $r = $r->{$_} ||= node($r, $_, 0, 0) foreach split '/';
  177.         $entries2node{$_} = node($r, $_, 1, 0) foreach sort uniq @{$groups{$_}};
  178.     }
  179.     }
  180.     $tree->signal_connect("select_row" => sub { select_row($tree->get_pixtext($_[1], 0)) });
  181. }
  182.  
  183. sub Install { 
  184.     fork || exec "gurpmi", $current_name;
  185.     $tree->remove_node($entries2node{$current_name});
  186.     $installed{$current_name} = 1;
  187. }
  188.  
  189. sub Uninstall { 
  190.     my $w = $in->wait_message(_("Wait"), _("Checking dependencies"));
  191.     chop(my $n = `rpm -q $current_name`); 
  192.     %provides or load_provides();
  193.  
  194.     my %toremove; @toremove{$n, @{$provides{$n} || []}} = (); 
  195.     my $changed = 1; while ($changed) { $changed = 0;
  196.     local *F;
  197.     open F, "rpm -e --test " . join(" ", keys %toremove) . " 2>&1 |";
  198.     foreach (<F>) {
  199.         if (/package (\S+) is not installed/) {
  200.         delete $toremove{$1};
  201.         } elsif (/is needed by (\S+)/ && ! exists $toremove{$1}) {
  202.         $toremove{$1} = 1;
  203.         $changed = 1;
  204.         }
  205.     }
  206.     }
  207.     $w = undef;
  208.     my @toremove = keys %toremove or return;
  209.     @toremove == 1 or $in->ask_yesorno(_("Uninstall"), [ _("The following packages are going to be uninstalled"), @toremove ], 1) or return;
  210.     tryExec( _("Uninstalling the RPMs"), su("rpm", "-e", @toremove));
  211.  
  212.     foreach (`rpm -q @toremove 2>&1`) {
  213.     / (.*)-.+-/ or next;
  214.     delete $installed{$1};
  215.     $tree->remove_node($entries2node{$1});
  216.     delete $entries{$1};
  217.     }
  218. }
  219.  
  220. sub select_node {
  221.     my ($n) = @_;
  222.     my $r = $root; if (%$r) { $tree->expand($r = $r->{$_}) foreach split '/', $entries{$n}[0] }
  223.     $tree->select($entries2node{$n});
  224.     $tree->node_moveto($entries2node{$n}, 0, 0.5, 0);
  225.     select_row($n);
  226. }
  227. sub SearchPackage {
  228.     my ($old, $nb) if 0;
  229.     my $s = $in->ask_from_entry(_("Search"), _("Which package are looking for"), _("Regexp"), $old) or return;
  230.     $old eq $s ? $nb++ : (($old, $nb) = ('', 0));
  231.     my $i = 0; foreach (keys %entries) {
  232.     if ($i < $nb) {
  233.         $i++ if /$old/i;
  234.     } else {
  235.         /$s/i and select_node($_), goto found;
  236.     }
  237.     }
  238.     $in->ask_warn(_("No match"), $nb ? _("No more match") : _("%s not found", $s));
  239.     $nb = -1;
  240. found:
  241.     $old = $s;
  242. }
  243. sub SearchPackageFile {
  244.     unless ($bigMem) {
  245.     $in->ask_okcancel('', 
  246. _("rpmdrake is currently in ``low memory'' mode.
  247. I'm going to relaunch rpmdrake to allow searching files"), 1) or return;
  248.     $bigMem = 1;
  249.     my $w = $in->wait_message('', '');
  250.     CreateTree();
  251.     }
  252.     my ($old, $nb) if 0;
  253.     my $s = $in->ask_from_entry(_("Search"), _("Which file are you looking for"), _("File"), $old) or return;
  254.     $old eq $s ? $nb++ : (($old, $nb) = ('', 0));
  255.     my $i = 0; while (my ($n, $v) = each %entries) {
  256.     if ($i < $nb) {
  257.         $i++ if index($v->[-1], $old) >= 0;
  258.     } else {
  259.         index($v->[-1], $s) >= 0 and select_node($n), goto found;
  260.     }
  261.     }
  262.     $in->ask_warn(_("No match"), $nb ? _("No more match") : _("%s not found", $s));
  263.     $nb = -1;
  264. found:
  265.     $old = $s;
  266. }
  267. sub SearchPackageDescr {
  268.     my ($old, $nb) if 0;
  269.     my $s = $in->ask_from_entry(_("Search"), _("What are looking for"), _("Regexp"), $old) or return;
  270.     $old eq $s ? $nb++ : (($old, $nb) = ('', 0));
  271.     my $i = 0; while (my ($n, $v) = each %entries) {
  272.     if ($i < $nb) {
  273.         $i++ if $v->[4] =~ /$old/ || $v->[5] =~ /$old/;
  274.     } else {
  275.         $v->[4] =~ /$s/ || $v->[5] =~ /$s/ and select_node($n), goto found;
  276.     }
  277.     }
  278.     $in->ask_warn(_("No match"), $nb ? _("No more match") : _("%s not found", $s));
  279.     $nb = -1;
  280. found:
  281.     $old = $s;
  282. }
  283.  
  284. sub AddMedia {
  285.     local ($_) = lc $_[0];
  286.     my ($name, $dir, $with);
  287.     for (my $i = 1; member($name = "${_}_$i", @medias); $i++) {}
  288.  
  289.     my @e = (_("Give a name (eg: `extra', `commercial')"), => \$name);
  290.     if (/local/) {
  291.     push @e, _("Directory") => \$dir;
  292.     } elsif (/cdrom/) {
  293.     eval { all("/mnt/cdrom") } && !$@ or system("mount /mnt/cdrom");
  294.     eval { all("/mnt/cdrom") } && !$@ or $in->ask_warn(_("Error"), _("No cdrom available (nothing in /mnt/cdrom)")), return;
  295.     } else {
  296.     $dir = "$_://";
  297.     $with = "../base/hdlist";
  298.     push @e, _("URL of the directory containing the RPMs") => \$dir;
  299.     push @e, _("For FTP and HTTP, you need to give the location for hdlist
  300. It must be relative to the URL above") => \$with;
  301.     }
  302.     $in->ask_from_entries_refH(_("Add"), _("Please submit the following information"), \@e,
  303.                    complete => sub {
  304.                    member($name, @medias) and $in->ask_warn(_("Error"), _("%s is already in use", $name)), return (1, 0);
  305.                    }) or return;
  306.     my $param;
  307.     if (/local/) {
  308.     $param = "file:/$dir";
  309.     } elsif (/cdrom/) {
  310.     my $nb = -e "/mnt/cdrom/Mandrake/base" ? 1 : 3;
  311.     $param = "removable_cdrom_$nb://mnt/cdrom";
  312.     } else {
  313.     $param = "$dir with $with";
  314.     }
  315.     tryExec(_("Updating the RPMs base"), su("/usr/sbin/urpmi.addmedia", $name, $param));
  316.     exec $0; 
  317. }
  318.  
  319. sub UpdateMedia {
  320.     my ($m) = @_;
  321.     tryExec(_("Updating the RPMs base"), su("/usr/sbin/urpmi.update", $m));
  322.     CreateTree();
  323. }
  324.  
  325.  
  326. sub RemoveMedia {
  327.     my ($m) = @_;
  328.     $in->ask_okcancel(_("Remove"), _("Going to remove entry %s", $m), 1) or return;
  329.     tryExec(_("Updating the RPMs base"), su("/usr/sbin/urpmi.removemedia", $m));
  330.     exec $0; 
  331. }
  332.  
  333. sub add_header {
  334.     my ($h, $name) = @_;
  335.     if (exists $entries{$name}) {
  336.     my $i; for ($i = 2; exists $entries{"$name-$i"}; $i++) {}
  337.     $name = "$name-$i";
  338.     }
  339.     push @{$groups{c::headerGetEntry($h, "group")}}, $name;
  340.     $entries{$name} = [ map { c::headerGetEntry($h, $_) } qw(group version release size summary description) ]; 
  341.     push @{$entries{$name}}, join("\n", c::headerGetEntry($h, 'filenames')) if $bigMem;
  342. }
  343.  
  344. sub read_hdlists {
  345.     foreach (glob_("$DIR/hdlist.*")) {
  346.     local *F; 
  347.     open F, /\.gz$/ ? "gzip -dc $_ |" : $_ or next;
  348.     while (my $h = c::headerRead(fileno *F, 1)) {
  349.         my $name = c::headerGetEntry($h, "name") or next;
  350.         next if exists $installed{$name};
  351.         add_header($h, $name);
  352.         c::headerFree($h);
  353.     }
  354.     }
  355. }
  356.  
  357. sub read_installed {
  358.     my ($leaves) = @_;
  359.     my %leaves; do { 
  360.     my $w = $in->wait_message(_("Finding leaves"), _("Finding leaves takes some time"));
  361. #    if ($leaves =~ /urpmi/) {
  362.         @leaves{ map { chop; $_ } `$leaves` } = ();
  363. #    } else {
  364. #        @leaves{ map { /(.*)-[^-]+-/ } `$leaves` } = ();
  365. #    }
  366.     } if $leaves;
  367.  
  368.     my $db = c::rpmdbOpenForTraversal('') or die "unable to open /var/lib/rpm/packages.rpm";
  369.     c::rpmdbTraverse($db, sub {
  370.     my $name = c::headerGetEntry($_[0], "name") or return;
  371.     return if $leaves && !exists $leaves{$name};
  372.     add_header($_[0], $name);
  373.     });
  374.     c::rpmdbClose($db);
  375. }
  376.  
  377. sub load_provides {
  378.     local *F;
  379.     open F, "$DIR/depslist" or return;
  380.     foreach (<F>) {
  381.     my ($p, undef, @l) = split;
  382.     push @{$provides{$_}}, $p foreach @l;
  383.     }
  384. }
  385.  
  386. sub xpm { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm($w->window, $w->style->bg('normal'), @_) }
  387. sub xpm_d { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm_d($w->window, undef, @_) }
  388. sub gtkxpm { new Gtk::Pixmap(xpm(@_)) }
  389. sub node { 
  390.     my ($node, $text, $leaf, $expanded) = @_;
  391.     $node = undef unless ref $node eq "Gtk::CTreeNode";
  392.     if ($leaf) {
  393.     $tree->insert_node($node, undef, [ $text ], 5, 
  394.                $icon[0], $icon[1],
  395.                undef, undef,
  396.                1, $expanded);
  397.     } else {
  398.     $tree->insert_node($node, undef, [ $text ], 5, 
  399.                $group_close[0], $group_close[1],
  400.                $group_open[0],  $group_open[1],
  401.                0, $expanded);
  402.     }
  403. }
  404.  
  405. sub su { $> ? ("kdesu", "-c", join(" ", @_)) : @_ }
  406. sub tryExec {
  407.     my $mesg = shift;
  408.     my $pid = fork or exec @_;
  409.     my $w = $in->wait_message(_("Wait"), $mesg);
  410.     until (waitpid($pid, &WNOHANG)) { my_gtk::flush; sleep 1 }
  411. }
  412.  
  413. BEGIN {
  414. @icon_xpm = (
  415. '15 16 11 1',
  416. '     c None',
  417. '.    c #020204',
  418. '+    c #637BA6',
  419. '@    c #D3AE24',
  420. '#    c #F9C80B',
  421. '$    c #433C27',
  422. '%    c #7489AA',
  423. '&    c #605F53',
  424. '*    c #332F21',
  425. '=    c #A79445',
  426. '-    c #887837',
  427. '               ',
  428. '               ',
  429. '         #$    ',
  430. '    -   @#*    ',
  431. '   $##@@##*    ',
  432. '    -#####=    ',
  433. '     @######@- ',
  434. '     ######@-$ ',
  435. '    @#####&.   ',
  436. '   -#=%@##*    ',
  437. '    *$%&@#*    ',
  438. '     %%* @*    ',
  439. '     +&&       ',
  440. '     %*        ',
  441. '    %%         ',
  442. '    %*         ',
  443. );
  444. @group_open_xpm = (
  445. '16 16 8 1',
  446. '     c None',
  447. '.    c #020204',
  448. '+    c #938A6D',
  449. '@    c #D4C495',
  450. '#    c #B0A57E',
  451. '$    c #605A4A',
  452. '%    c #363531',
  453. '&    c #E4DBC0',
  454. '                ',
  455. '                ',
  456. '    ....        ',
  457. '   .####.       ',
  458. '  .
  459. '  .
  460. ' ...........$%+.',
  461. '.&&&&&&@&&&@.$$.',
  462. '.&@#@#@#@#@#.$$.',
  463. ' .&@#@#@#@#@+.$.',
  464. ' %&#@#@#@#@#@.$.',
  465. '  %&#@#@#@#@#$..',
  466. '  .@
  467. '   ............ ',
  468. '                ',
  469. '                ',
  470. );
  471.  
  472. @group_close_xpm = (
  473. '16 16 11 1',
  474. '     c None',
  475. '.    c #020204',
  476. '+    c #8E866C',
  477. '@    c #CCC4A8',
  478. '#    c #AEA683',
  479. '$    c #E9E3CF',
  480. '%    c #C5B993',
  481. '&    c #676352',
  482. '*    c #7E7361',
  483. '=    c #DACFA8',
  484. '-    c #A09578',
  485. '                ',
  486. '                ',
  487. '    ....        ',
  488. '   .%-%-.       ',
  489. '  .
  490. '  .$$$$$$$$@=$%.',
  491. '  .=%=%=%=%%#%+.',
  492. '  .$=%=%=%%#%#*.',
  493. '  .=%=%@%%#%##&.',
  494. '  .$=%=%%#%#
  495. '  .=%=#%#%#
  496. '  .$=%%#%#
  497. '  .=*+*-*+*&&&&.',
  498. '   ............ ',
  499. '                ',
  500. '                ',
  501. );
  502.  
  503. }
  504.